home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Run Magazine ReRun: Super Starter Pak 2
/
rerun-super-starter-pak-ii-1991-side-b.d64
/
label base
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
6KB
|
204 lines
10 rem label base 64/128
20 rem by bob kodadek
30 :
40 ps=0:ll=3:q=250:c=40:mo=64:ml=828:yr=782:print chr$(142)
50 if peek(40960)=0 then mo=128:ml=4864:poke828,183:if peek(215) then c=80
60 sp$=chr$(32):m$=chr$(44):if mo=128 then yr=8:q=350
70 if c=80 then poke53265,peek(53265) and 239:poke 53296,1:rem fast mode
80 b$=chr$(13)+chr$(18):o$=chr$(146):for i=0 to 6:read fd$(i),l%(i):next
90 for i=3 to c:l$=l$+chr$(163):next:fori=0 to 39:e$=e$+sp$:next
100 for i=0 to 89:read by:poke ml+i,by:ck=ck+by:next:if ps then print chr$(14)
110 if ck<>14598 then print"data error":end
120 dim r$(q,7),k(q):fori=1 to q:k(i)=i:next
130 :
140 rem - menu 1 -
150 close1:close5:close15:gosub300:print
160 print b$ spc(5)"f1" o$" - load file"
170 print b$ spc(5)"f3" o$" - save file"
180 print b$ spc(5)"f5" o$" - select records"
190 print b$ spc(5)"f7" o$" - directory "
200 print b$ spc(5)"f2" o$" - enter data"
210 print b$ spc(5)"f4" o$" - alphabetize"
220 print b$ spc(5)"f6" o$" - print menu"
230 gosub310:kp=asc(a$)-132:if kp<1 or kp>7 then 230
240 on kp gosub430,560,650,1330,980,880,1590
250 goto150
260 :
270 x=20:y=0:gosub280:print e$:return
280 if mo=64 then poke781,x:poke yr,y:poke783,0:sys65520:return
290 poke7,x:poke yr,y:poke5,0:sys65520:return
300 print chr$(147)" label base" mo"- file: "fs$:print spc(1) l$:return
310 a$="":get a$:if a$="" then 310
320 return
330 f$="":input f$:le=len(f$):return
340 input#15,en$,em$,et$,es$:en=val(en$):return
350 gosub270:x=19:y=0:gosub280
360 close 5:close 15
370 print b$ "drive status:" o$+sp$+en$+m$+em$+m$+et$+m$+es$
380 print:print"press return"
390 gosub310:ifa$<>chr$(13)then 390
400 return
410 :
420 rem - load file -
430 print:print"load which file";:gosub330
440 if le<1 then return
450 if f$="new" then nr=0:rn=0:fs$="":return
460 open 15,8,15:open 5,8,5,"lb."+f$+",s,r"
470 gosub340:if en<>0 then 350
480 print:print"reading " f$;:rn=1
490 for i=rn to q:for n=0 to 6:input#5,r$(i,n)
500 if st=64 then520
510 next n:next i
520 nr=i:for i=1 to q:k(i)=i:next
530 fs$=f$:goto350
540 :
550 rem - save file -
560 print:print"save to filename";:gosub330
570 if le<1 then return
580 open 15,8,15:print#15,"s0:lb."+f$
590 open 5,8,5,"lb."+f$+",s,w":gosub340
600 print:print"writing " f$;:if en<>0 then350
610 for i=1 to nr:for n=0 to 6:if r$(k(i),n)="" then r$(k(i),n)=sp$
620 print#5,r$(k(i),n):next n:next i:goto350
630 :
640 rem - select records -
650 gosub1080:gosub310
660 if a$=chr$(13) then return
670 if a$="f"then if nr then rn=1
680 if a$="l"then rn=nr
690 if a$="r"and nr then gosub1500:goto650
700 if a$="p"and rn>1 then rn=rn-1
710 if a$="n"and rn<nr then rn=rn+1
720 if a$="k"then gosub1430
730 if a$="d"and nr then gosub1260:ifrn>nrthenrn=rn-1
740 if a$="a"then gosub980
750 if a$="e"and nr then gosub1160
760 if a$=chr$(16) then gosub1690
770 if a$="?"then gosub790
780 close4:goto650
790 gosub300:x=5:y=8:gosub280:print"help menu":print
800 print spc(8)"f - first record":print spc(8)"n - next record"
810 print spc(8)"p - previous record":print spc(8)"l - last record"
820 print spc(8)"k - key field match":print spc(8)"a - add records"
830 print spc(8)"d - delete record":print spc(8)"r - replace record"
840 print spc(8)"e - edit current record"
850 gosub380:return
860 :
870 rem - sort records
880 y=nr:print:print"sorting";
890 y=int(y/2):ify=0then return
900 j=1:k=nr-y
910 i=j
920 l=i+y:print".";:if r$(k(i),0)<=r$(k(l),0) then 940
930 t=k(i):k(i)=k(l):k(l)=t:i=i-y:if i>0 then 920
940 j=j+1:if j>k then 890
950 goto910
960 :
970 rem - entry
980 t=nr+1:if t>q then return
990 rn=t:nr=t:flag=1:for i=0 to 6:r$(rn,i)="":next
1000 gosub1080:for i=0 to 6:x=8+i:y=11:gosub280:poke yr,l%(i)
1010 sys ml:c1=peek(yr):if c1=0 then r$(rn,i)=sp$:goto1030
1020 for s=1 to c1:r$(rn,i)=r$(rn,i)+chr$(peek(255+s)):next s
1030 next i:k(rn)=rn:gosub270:y=6:gosub280:print"press space bar for another"
1040 gosub310:ifa$=sp$ then 980
1050 flag=0:return
1060 :
1070 rem - display record -
1080 gosub300:x=4:y=5:gosub280:print"record #"rn"of"nr
1090 x=8:y=0:gosub280:for i=0 to 6:ld=36-(24-l%(i))
1100 print spc(8-len(fd$(i))) fd$(i)" < "r$(k(rn),i) tab(ld)">":next
1110 if flag then return
1120 if flag=0 then x=18:y=8:gosub280:print "(press ctrl-p to print)"
1130 x=20:y=1:gosub280:print"select - f, n, p, l, k, a, d, r, e, ?"
1140 return
1150 :
1160 rem - edit record -
1170 gosub300:x=4:y=5:gosub280:print"record #"rn"of"nr
1180 x=8:y=0:gosub280:for i=0 to 6
1190 if r$(k(rn),i)="" or r$(k(rn),i)=sp$ then r$(k(rn),i)="*"
1200 print spc(8-len(fd$(i))) fd$(i)": "r$(k(rn),i)
1210 print chr$(145) tab(10);:open1,0:input#1,r$(k(rn),i)
1220 if r$(k(rn),i)="*" then r$(k(rn),i)=""
1230 print:close1:next:return
1240 :
1250 rem - delete record -
1260 gosub270:y=5:gosub280:print"delete this record? (y or n)"
1270 gosub310:if a$<>"y" then return
1280 for n=0 to 6:r$(k(rn),n)=r$(nr,n):r$(nr,n)="":next
1290 for i=1 to nr:ifk(i)=nr then k(i)=k(nr):k(nr)=0:nr=nr-1:return
1300 next:return
1310 :
1320 rem - read directory
1330 gosub300:print:print
1340 open15,8,15:open1,8,0,"$0:lb.*":gosub340:ifen<>0then350
1350 n$=chr$(0):get#1,a$,a$
1360 get#1,a$,a$:if a$=""then 1400
1370 get#1,a$,c$:print asc(a$+n$)+asc(c$+n$)*256;
1380 get#1,a$:ifa$=""then print:goto1360
1390 printa$;:goto1380
1400 goto360
1410 :
1420 rem - key string -
1430 gosub270:y=6:gosub280
1440 print"enter key -";:inputk$
1450 for i=1 to nr
1460 if k$=left$(r$(k(i),0),len(k$)) then rn=i:return
1470 next:return
1480 :
1490 rem - replace record
1500 gosub270:y=5:gosub280:print"replace this record? (y or n)"
1510 gosub310:if a$<>"y" then return
1520 for i=0 to 6:r$(k(rn),i)="":next
1530 gosub1080:for i=0 to 6:x=8+i:y=11:gosub280:poke yr,l%(i)
1540 sysml:c1=peek(yr):if c1=0 then r$(k(rn),i)=sp$:goto1560
1550 for s=1 to c1:r$(k(rn),i)=r$(k(rn),i)+chr$(peek(255+s)):next s
1560 next i:return
1570 :
1580 rem - print menu -
1590 gosub300:print:print
1600 print b$ spc(5)"f1" o$" - print current record"
1610 print b$ spc(5)"f3" o$" - print all records"
1620 print b$ spc(5)"f5" o$" - print phone list"
1630 gosub310:if a$=chr$(13) then return
1640 kp=asc(a$)-132:if kp<1 or kp>3 then 1630
1650 on kp gosub1690,1800,1850
1660 close4:goto1590
1670 :
1680 rem - print record -
1690 cn=1:open4,4,ps:close4:ss=st:if ss then return
1700 print:print"how many labels? 1";:input"[157][157][157]";cn
1710 open4,4,ps:if cn <1 then return
1720 for i=1 to cn
1730 print#4,r$(k(rn),1) chr$(32) r$(k(rn),0)
1740 print#4,r$(k(rn),2)
1750 print#4,r$(k(rn),3)","chr$(32) r$(k(rn),4) chr$(32);
1760 print#4,r$(k(rn),5)
1770 for s=1 to ll:print#4:next s:next i:return
1780 :
1790 rem - print all records -
1800 t=rn:rn=1:gosub1690:if cn<1 or ss then return
1810 rn=rn+1:gosub1720:if rn<nr then 1810
1820 rn=t:return
1830 :
1840 rem - print phone list -
1850 lc=0:lf=5:open4,4,ps:close4:if st then return
1860 open4,4,ps:for i=1 to nr:ns=0
1870 for n=0 to 2:print#4,r$(k(i),n) chr$(32);
1880 ns=ns+len(r$(k(i),n))+1:next n
1890 ns=ns+len(r$(k(i),6)):nd=79-ns
1900 for d=1 to nd:print#4,"-";:next d
1910 print#4,r$(k(i),6):lc=lc+1:if lc<60 then 1930
1920 for lc=0 to lf:print#4:next lc:lc=0
1930 next i:return
1940 :
1950 data last,15,first,18,street,24
1960 data city,24,state,2,zip,12,phone,12
1970 :
1980 data 132,252,160,0,132,251,240,49,32,228,255,240,251,164,251,201,13
1990 data 208,6,169,32,32,210,255,96,201,20,240,40,196,252,240,231,201
2000 data 32,144,227,201,34,240,223,201,161,176,4,201,128,176,215,153,0
2010 data 1,230,251,32,210,255,169,161,32,210,255,169,157,32,210,255,208
2020 data 195,192,0,240,240,198,251,169,32,32,210,255,169,157,32,210,255
2030 data 32,210,255,208,223